home *** CD-ROM | disk | FTP | other *** search
/ MacWorld Ultimate Mac / Macworld Ultimate Mac CD-ROM (1994)(IDG).iso / The Best of BMUG / Utilities / Control Panels and Extensions / ClipboardMagician.76 / testmagic.p < prev   
Text File  |  1992-07-06  |  10KB  |  447 lines
  1. program main;
  2.     uses
  3.         UConvertor;
  4.     const
  5.         infoType = 'CNV!';
  6.         convertMax = 20; { max number of convertor type supported }
  7.     type
  8.         PInteger = ^Integer;
  9.         HInteger = ^PInteger;
  10.         PLongint = ^Longint;
  11.         PResType = ^ResType;
  12.         EightChar = packed array[1..8] of char;
  13.         extraParm = record
  14.                 theParmInfo: ParmInfo;
  15.                 cnvtType: ResType;
  16.                 cnvtHandle: Handle;
  17.             end;
  18.  
  19.     var
  20.         myList: ListHandle;
  21.         aString: str255;
  22.         i: integer;
  23.         appleMenu, fileMenu, editMenu: menuHandle;
  24.         quit: boolean;
  25.         theWindow: windowPtr;
  26.  
  27.         convertCount: integer;
  28.         convertor: array[1..convertMax] of ResType;
  29.  
  30.     function GoExec (rInfoPtr: routineInfoPtr; pInfoPtr: parmInfoPtr; excAddr: Ptr): OSErr;
  31.     inline
  32.         $205F, $4e90;{ move.l (A7)+, A0;  jsr (A0)}
  33.  
  34.     procedure NumToHex (aLong: longint; var aEightChar: EightChar);
  35.         var
  36.             i, digit: integer;
  37.     begin
  38.         for i := 8 downto 3 do
  39.             begin
  40.                 digit := BAnd(aLong, 15);
  41.                 if digit < 10 then
  42.                     aEightChar[i] := chr(ord('0') + digit)
  43.                 else
  44.                     aEightChar[i] := chr(ord('A') + digit - 10);
  45.                 aLong := BSR(aLong, 4);
  46.             end;
  47.         aEightChar[1] := ' ';
  48.         aEightChar[2] := ' ';
  49.     end;
  50.  
  51.     procedure GetSelected (var theType: ResType; var theHandle: Handle);
  52.         var
  53.             curCell: point;
  54.             tempBuf: packed array[1..12] of char;
  55.             v, i: integer;
  56.             theValue: longint;
  57.             dataLen: integer;
  58.             aChar: char;
  59.     begin
  60.         theValue := 0;
  61.         setPt(curCell, 0, 0);
  62.         if LGetSelect(TRUE, curCell, myList) then
  63.             begin
  64.                 dataLen := 4;
  65.                 LGetCell(@theType, dataLen, curCell, myList);
  66.                 dataLen := 12;
  67.                 LGetCell(@tempBuf, dataLen, curCell, myList);
  68.                 for i := 1 to 6 do
  69.                     begin
  70.                         aChar := tempBuf[i + 6];
  71.                         if aChar > '9' then
  72.                             v := ord(aChar) - ord('A') + 10
  73.                         else
  74.                             v := ord(aChar) - ord('0');
  75.                         theValue := theValue * 16 + v;
  76.                     end;
  77.             end;
  78.         theHandle := Handle(theValue);
  79.     end;
  80.  
  81.     procedure CopySelected;
  82.         var
  83.             ahandle: Handle;
  84.             aType: ResType;
  85.             dummy: integer;
  86.     begin
  87.         GetSelected(aType, aHandle);
  88.         if aHandle <> nil then
  89.             begin
  90.                 dummy := ZeroScrap;
  91.                 HLock(aHandle);
  92.                 dummy := PutScrap(GetHandleSize(aHandle), aType, aHandle^);
  93.                 HUnLock(aHandle);
  94.             end;
  95.     end;
  96.  
  97.     procedure CutSelected;
  98.         var
  99.             curCell: point;
  100.             aHandle: Handle;
  101.             aType: ResType;
  102.     begin
  103.         setPt(curCell, 0, 0);
  104.         if LGetSelect(TRUE, curCell, myList) then
  105.             begin
  106.                 GetSelected(aType, aHandle);
  107.                 if aHandle <> nil then
  108.                     begin
  109.                         CopySelected;
  110.                         DisposHandle(aHandle);
  111.                     end;
  112.                 LDelRow(1, curCell.v, myList);
  113.             end;
  114.     end;
  115.  
  116.     procedure AddToList (theType: ResType; theHandle: Handle);
  117.         var
  118.             aEightChar: EightChar;
  119.             theCell: point;
  120.             theRow: integer;
  121.     begin
  122.         NumToHex(ord(theHandle), aEightChar);
  123.         theRow := LAddRow(1, myList^^.dataBounds.bottom, myList);
  124.         SetPt(theCell, 0, theRow);
  125.         LSetCell(@theType, 4, theCell, myList);
  126.         LAddToCell(@aEightChar, 8, theCell, myList);
  127.     end;
  128.  
  129.     procedure PasteScrap;
  130.         var
  131.             disp: longint;
  132.             theSize: longint;
  133.             dummy: longint;
  134.             theType: ResType;
  135.             scrapPtr: PScrapStuff;
  136.             err: OSErr;
  137.             aHandle: Handle;
  138.     begin
  139.         scrapPtr := InfoScrap;
  140.         with scrapPtr^ do
  141.             begin
  142.                 dummy := LoadScrap;
  143.                 disp := 0;
  144.                 while disp < scrapSize do
  145.                     begin
  146.                         theType := PResType(ord(scrapHandle^) + disp)^;
  147.                         disp := disp + 4;
  148.                         theSize := PLongint(ord(scrapHandle^) + disp)^;
  149.                         disp := disp + 4;
  150.                         HLock(scrapHandle);
  151.                         if PtrToHand(Ptr(ord(scrapHandle^) + disp), aHandle, theSize) = NoErr then
  152.                             AddToList(theType, aHandle);
  153.                         HUnLock(scrapHandle);
  154.                         disp := disp + theSize;
  155.                         if odd(disp) then
  156.                             disp := disp + 1;
  157.                     end;
  158.             end;
  159.     end;
  160.  
  161.     function CallByName (rtnRsrc: ResType; rtnName: str255; theParCount: integer; usingDefault: boolean; aParmPtr: parmInfoPtr): OSErr;
  162.         var
  163.             flag: SignedByte;
  164.             rtnInfo: routineInfo;
  165.             resHandle: handle;
  166.             aName: Str255;
  167.             rtnID, rtnIndex: integer;
  168.             i: integer;
  169.             tempHandle: Handle;
  170.             realID: Integer;
  171.             myExtraInfo: extraParm;
  172.     begin
  173.         resHandle := nil;
  174.         if rtnRsrc = InfoType then
  175.             begin
  176.                 tempHandle := Get1NamedResource(rtnRsrc, rtnName);
  177.                 if tempHandle <> nil then
  178.                     begin
  179.                         GetResInfo(tempHandle, realID, rtnRsrc, rtnName);
  180.                         for i := 1 to convertCount do
  181.                             begin
  182.                                 resHandle := Get1Resource(convertor[i], realID);
  183.                                 if resHandle <> nil then
  184.                                     begin
  185.                                         GetResInfo(resHandle, realID, rtnRsrc, rtnName);
  186.                                         leave;
  187.                                     end;
  188.                             end;
  189.                     end;
  190.             end
  191.         else
  192.             resHandle := Get1NamedResource(rtnRsrc, rtnName);
  193.         if resHandle <> nil then
  194.             begin
  195.                 if rtnRsrc = 'CNVT' then
  196.                     begin
  197.                         aParmPtr^.dstHandle := nil;
  198.                         with rtnInfo do
  199.                             begin
  200.                                 entryPoint := @CallByName;
  201.                                 parmCount := theParCount;
  202.                                 useDefault := usingDefault;
  203.                             end;
  204.                         MoveHHi(resHandle);
  205.                         flag := HGetState(resHandle);
  206.                         HLock(resHandle);
  207.                         CallByName := GoExec(@rtnInfo, aParmPtr, resHandle^);
  208.                         HSetState(resHandle, flag);
  209.                     end
  210.                 else
  211.                     begin
  212.                         aName := '    Do????';
  213.                         BlockMove(@rtnRsrc, @aName[7], 4);
  214.                         with myExtraInfo do
  215.                             begin
  216.                                 BlockMove(Ptr(aParmPtr), @myExtraInfo, SizeOf(parmInfo));
  217.                                 cnvtType := rtnRsrc;
  218.                                 cnvtHandle := resHandle;
  219.                             end;
  220.                         CallByName := CallByName('CNVT', aName, 3, usingDefault, @myExtraInfo);
  221.                         BlockMove(@myExtraInfo, Ptr(aParmPtr), SizeOf(parmInfo));
  222.                     end;
  223.             end
  224.         else
  225.             CallByName := ResError;
  226.     end;
  227.  
  228.     procedure DoSelected;
  229.         var
  230.             aRoutineInfo: routineInfo;
  231.             aParmInfo: parmInfo;
  232.             aType: ResType;
  233.             aHandle: Handle;
  234.             aPtr: Ptr;
  235.             dataLen: longint;
  236.             dataEnd: longint;
  237.     begin
  238.         GetSelected(aType, aHandle);
  239.         if (testType = '****') or (testType = '____') or (testType = aType) then
  240.             if (aHandle <> nil) or (testType = '____') then
  241.                 begin
  242.                     with aRoutineInfo do
  243.                         begin
  244.                             entryPoint := @CallByName;
  245.                             resID := testID;
  246.                             parmCount := 4;
  247.                             useDefault := true;
  248.                         end;
  249.                     with aParmInfo do
  250.                         begin
  251.                             srcType := aType;
  252.                             srcHandle := aHandle;
  253.                             dstHandle := nil;
  254.                         end;
  255.                     if xMain(@aRoutineInfo, @aParmInfo) = NoErr then
  256.                         if aParmInfo.dstHandle <> nil then
  257.                             with aParmInfo do
  258.                                 begin
  259.                                     if dstType <> 'scrp' then
  260.                                         AddToList(dstType, dstHandle)
  261.                                     else
  262.                                         begin
  263.                                             HLock(dstHandle);
  264.                                             aPtr := dstHandle^;
  265.                                             dataEnd := ord(aPtr) + GetHandleSize(dstHandle);
  266.                                             while ord(aPtr) < dataEnd do
  267.                                                 begin
  268.                                                     aType := PResType(aPtr)^;
  269.                                                     aPtr := Ptr(ord(aPtr) + 4);
  270.                                                     dataLen := PLongint(aPtr)^;
  271.                                                     aPtr := Ptr(ord(aPtr) + 4);
  272.                                                     if PtrToHand(aPtr, aHandle, dataLen) = NoErr then
  273.                                                         AddToList(aType, aHandle);
  274.                                                     if odd(dataLen) then
  275.                                                         dataLen := dataLen + 1;
  276.                                                     aPtr := Ptr(ord(aPtr) + dataLen);
  277.                                                 end;
  278.                                             HUnLock(dstHandle);
  279.                                             DisposHandle(dstHandle);
  280.                                         end;
  281.                                 end;
  282.                 end;
  283.     end;
  284.  
  285.     procedure Initalize;
  286.         var
  287.             aString: str255;
  288.             r, bounds: rect;
  289.             cSize: point;
  290.  
  291.             i, n, anID: integer;
  292.             aType: ResType;
  293.             aName, cnvStr: str255;
  294.             aHandle: Handle;
  295.     begin
  296.         convertCount := 1;
  297.         convertor[1] := 'CNVT';
  298.         n := CountResources('CNVT');
  299.         cnvStr := '    Do';
  300. { find out all convertor type supported by '    DoXXXX' CNVT }
  301.         for i := 1 to n do
  302.             begin
  303.                 SetResLoad(false);
  304.                 aHandle := GetIndResource('CNVT', i);
  305.                 SetResLoad(true);
  306.                 if aHandle <> nil then
  307.                     begin
  308.                         GetResInfo(aHandle, anID, aType, aName);
  309.                         if (length(aName) = 10) & (IUMagIDString(@aName[1], @cnvStr[1], 6, 6) = 0) then
  310.                             if convertCount < convertMax then
  311.                                 begin
  312.                                     convertCount := convertCount + 1;
  313.                                     BlockMove(@aName[7], @convertor[convertCount], 4);
  314.                                 end;
  315.                     end;
  316.             end;
  317.         aString := ' ';
  318.         aString[1] := chr(appleMark);
  319.         appleMenu := NewMenu(1, aString);
  320.         AddResMenu(appleMenu, 'DRVR');
  321.         aString := 'File';
  322.         fileMenu := NewMenu(2, aString);
  323.         AppendMenu(fileMenu, 'Test/T;-;Quit/Q');
  324.         aString := 'Edit';
  325.         editMenu := NewMenu(3, aString);
  326.         AppendMenu(editMenu, 'Cut/X;Copy/C;Paste/V');
  327.         InsertMenu(appleMenu, 0);
  328.         InsertMenu(fileMenu, 0);
  329.         InsertMenu(editMenu, 0);
  330.         DrawMenuBar;
  331.         quit := false;
  332.         InitCursor;
  333.         SetRect(r, 20, 50, 140, 180);
  334.         theWindow := NewWindow(nil, r, '', true, 2, Pointer(-1), false, 0);
  335.         SetPort(theWindow);
  336.         OffsetRect(r, -20, -50);
  337.         InsetRect(r, 1, 1);
  338.         r.right := r.right - 15;
  339.         SetRect(bounds, 0, 0, 1, 0);
  340.         SetPt(cSize, r.right - r.left, 16);
  341.         myList := LNew(r, bounds, cSize, 0, theWindow, true, false, false, true);
  342.         with myList^^ do
  343.             begin
  344.                 selFlags := lOnlyOne;
  345.                 listFlags := lDoVAutoScroll;
  346.             end;
  347.         PasteScrap;
  348.     end;
  349.  
  350.     procedure DoMenu (result: longint);
  351.         var
  352.             menu, item: integer;
  353.     begin
  354.         menu := HiWord(result);
  355.         item := LoWord(result);
  356.         case menu of
  357.             1: 
  358.                 begin
  359.                     GetItem(appleMenu, item, aString);
  360.                     i := OpenDeskAcc(aString);
  361.                 end;
  362.             2: 
  363.                 begin
  364.                     case item of
  365.                         1: 
  366.                             DoSelected;
  367.                         3: 
  368.                             quit := true;
  369.                     end;
  370.                 end;
  371.             3: 
  372.                 begin
  373.                     case item of
  374.                         1: 
  375.                             CutSelected;
  376.                         2: 
  377.                             CopySelected;
  378.                         3: 
  379.                             PasteScrap;
  380.                     end
  381.                 end;
  382.         end;
  383.         HiliteMenu(0);
  384.     end;
  385.  
  386.     procedure MainEventLoop;
  387.         var
  388.             event: EventRecord;
  389.             aWindow: windowPtr;
  390.             locPt: point;
  391.             part: integer;
  392.             i: integer;
  393.     begin
  394.         SystemTask;
  395.         if GetNextEvent(everyEvent, event) then
  396.             ;
  397.         case event.what of
  398.             activateEvt: 
  399.                 if WindowPtr(event.message) = theWindow then
  400.                     begin
  401.                         LActivate(odd(event.modifiers), myList);
  402.                     end;
  403.  
  404.             mouseDown: 
  405.                 begin
  406.                     part := FindWindow(event.where, aWIndow);
  407.                     case part of
  408.                         inDesk: 
  409.                             ;
  410.                         inSysWindow: 
  411.                             SystemClick(event, aWindow);
  412.                         inMenuBar: 
  413.                             begin
  414.                                 DoMenu(MenuSelect(event.where));
  415.                             end;
  416.                         inContent: 
  417.                             if FrontWindow <> theWindow then
  418.                                 SelectWindow(theWindow)
  419.                             else
  420.                                 begin
  421.                                     locPt := event.where;
  422.                                     GlobalToLocal(locPt);
  423.                                     if LClick(locPt, event.modifiers, myList) then
  424.                                         DoSelected;
  425.                                 end;
  426.                     end;
  427.                 end;
  428.  
  429.             keyDown: 
  430.                 if BitAnd(event.modifiers, CmdKey) <> 0 then
  431.                     DoMenu(MenuKey(Chr(BitAnd(event.message, CharCodeMask))));
  432.  
  433.             updateEvt: 
  434.                 begin
  435.                     BeginUpdate(theWindow);
  436.                     LUpdate(theWindow^.VisRgn, myList);
  437.                     EndUpdate(theWindow);
  438.                 end;
  439.         end;
  440.     end;
  441. begin
  442.     Initalize;
  443.     repeat
  444.         MainEventLoop;
  445.     until quit;
  446.     LDispose(myList);
  447. end.